home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / telecomm / bbs / bbbbs84.lha / rexx / bbsDoors.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1994-12-20  |  9.2 KB  |  418 lines
  1. /* $VER: bbsDoors.rexx 8.3 (19.12.94)
  2. copyright 1993-94 Richard Lee Stockton
  3. FREELY DISTRIBUTABLE
  4. Thanks to Matt English for "Jump.rexx"
  5. */
  6.  
  7. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  8. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  9.  
  10. SIGNAL ON BREAK_C
  11. SIGNAL ON FAILURE
  12. SIGNAL ON SYNTAX
  13. OPTIONS FAILAT 999999
  14. CALL TIME('R')
  15.  
  16. ARG maxtime name pw
  17. IF ~DATATYPE(maxtime,'N') THEN maxtime=3000
  18.  
  19. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  20. IF ADDRESS()='BAUD' THEN
  21.   DO
  22.     frombb=1
  23.     CR='0D'x
  24.   END
  25. ELSE
  26.   DO
  27.     frombb=0
  28.     CR=''
  29.   END
  30.  
  31. figarg='s:CONFIG.BBS'
  32. IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
  33. x=OPEN(f,figarg,'R')
  34. IF x=0 THEN
  35.   DO
  36.     SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'CR
  37.     EXIT(20)
  38.   END
  39. lynes.=''
  40. DO i=1 TO 6
  41.   lynes.i=READLN(f)
  42. END
  43. CALL CLOSE(f)
  44. compos=POS('/*',lynes.1)
  45. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  46. bbsname=STRIP(lynes.1)
  47. sysop  =WORD(lynes.2,1)
  48. bbspath=WORD(lynes.6,1)
  49. IF ~EXISTS(bbspath) THEN
  50.   DO
  51.     SAY bbspath 'does not exist!'CR
  52.     CALL SETCLIP('BBS_STAT')
  53.     EXIT(20)
  54.   END
  55. testchar=RIGHT(bbspath,1)
  56. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  57. IF GETCLIP('BBS_path')='' THEN CALL SETCLIP('BBS_path',bbspath)
  58. CALL PRAGMA('D',bbspath'rexxDoors')
  59. IF ARG()=0 THEN
  60.   DO
  61.     SAY
  62.     SAY '                       bbsDoors.rexx'
  63.     SAY '               Original by Matt English 9-30-92'
  64.     SAY '            Alterations by RLS through 11-25-94'
  65.     SAY
  66.   END
  67. IF name='' THEN
  68.   DO
  69.     SAY
  70.     SAY
  71.     options prompt' Are you 'sysop' ? Y or n > '
  72.     pull answer
  73.     if answer='Y' | answer='' then name=sysop
  74.     else DO
  75.       SAY
  76.       options prompt' Please enter your name > '
  77.       pull name
  78.       name=strip(name)
  79.       name=translate(name,'_',' ')
  80.       if name='' then CALL bye
  81.     END
  82.     SAY
  83.   END
  84. file=bbspath'Users/'name
  85. IF ~EXISTS(file) THEN
  86.   DO
  87.     SAY  CR
  88.     SAY 'I can''t find' name 'on the users list!'CR
  89.     SAY 'You should log on to the BBS before you try this!'CR
  90.     CALL delay(100)
  91.     CALL bye
  92.   END
  93.  
  94. colorflag=0
  95. userfile=bbspath'Users/'name
  96. CALL OPEN(data,userfile,'r')
  97. DO i=1 TO 20
  98.   line=readln(data)
  99.   IF i=5 THEN password=line
  100.   IF i=8 THEN
  101.     IF FIND(line,'COLOR')>0 THEN colorflag=1
  102.   IF i=18 THEN winnings=WORD(line,1)
  103.   IF i=20 THEN level=WORD(line,1)
  104.   END
  105. CALL close(data)
  106. IF ~DATATYPE(winnings,'N') THEN winnings=0
  107.  
  108. def='';bak2='';pen3=''
  109. IF colorflag=0 THEN
  110.   DO
  111.     def='';bak2='';pen3=''
  112.   END
  113.  
  114. IF pw~=password THEN
  115.   DO
  116.     passprompt=' 'pen3'Please Enter Password: '
  117.     DO tries=1 TO 3
  118.       OPTIONS PROMPT passprompt
  119.       PULL newpassword
  120.       SAY ''CR
  121.       IF(password=newpassword) THEN LEAVE tries; /* correct password */
  122.       IF tries=3 THEN
  123.         DO
  124.           SAY CR
  125.           SAY 'Access terminated.'CR
  126.           SAY '*** Bad password ***' newpassword '***'CR
  127.           CALL bye
  128.         END
  129.       passprompt='Incorrect.  Password: '
  130.     END
  131.     SAY CR
  132.     SAY' OK, 'name' here we go....'CR
  133.     SAY CR
  134.   END
  135.  
  136. CALL sortdoors()
  137. temp=1
  138. played=0
  139. DO doorloop=1
  140.   IF temp=0 THEN
  141.     DO
  142.       IF played THEN
  143.         DO
  144.           doors.0=''
  145.           CALL sortdoors()
  146.         END
  147.       SAY CR
  148.       SAY CENTER('- Number of accesses per file -',75)||CR
  149.     END
  150.   CALL showtime()
  151.   SAY pen3||LEFT('-',75,'-')||def||CR
  152.   DO jd=1 TO jdoors.0
  153.     IF temp=0 THEN SAY jdoors.jd.0||CR
  154.     ELSE SAY jdoors.jd||CR
  155.   END
  156.   SAY pen3||LEFT('-',75,'-')||def||CR
  157.   IF temp=0 THEN
  158.     DO
  159.       OPTIONS PROMPT '                                 'pen3'Press RETURN 'def
  160.       PULL junk
  161.       temp=1
  162.       SAY CR
  163.       ITERATE doorloop
  164.     END
  165.   arg='Menu'
  166.   CALL postuser()
  167.   temp=getinput(1 0 pen3'Select Application Number. 0=Stats > 'def)
  168.   IF temp=0 THEN ITERATE doorloop
  169.   IF ~DATATYPE(temp,'N') | temp<1 | temp>doors.0 THEN CALL bye
  170.   arg=doors.temp
  171.   IF GETCLIP('BBS_door')=arg | GETCLIP('BBS_localdoor')=arg THEN
  172.     DO
  173.       SAY 'That door is in use!  Try again in a few minutes...'CR
  174.       ITERATE doorloop
  175.     END
  176.   played=1
  177.   IF frombb THEN CALL SETCLIP('BBS_door',arg)
  178.   ELSE CALL SETCLIP('BBS_localdoor',arg)
  179.   CALL Increment.rexx(bbspath'rexxDoors/'arg)
  180.   savewinnings=0
  181.   testwin=''
  182.   IF frombb THEN
  183.     DO
  184.       CALL send2log(arg 'at' TIME('C'))
  185.       CALL SETCLIP('BBS_winnings')
  186.       timeleft=TRUNC(maxtime-TIME('E'))
  187.       IF UPPER(arg)='ONE_ARMED_BANDIT.REXX' THEN
  188.         IF getinput(1 1 'Play for this sessions time in seconds? (Ny) > ')='Y' THEN
  189.           DO
  190.             savewinnings=winnings
  191.             IF savewinnings=0 THEN savewinnings=1
  192.             winnings=timeleft
  193.             SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR
  194.           END
  195.       CALL postuser()
  196.     END
  197.   ELSE CALL TIME('R')
  198.   comm='CALL' arg'('TRANSLATE(name,'_','-') winnings savewinnings colorflag maxtime-TIME('E')-42')'
  199.   INTERPRET comm
  200.   IF frombb THEN
  201.     DO
  202.       testwin=GETCLIP('BBS_winnings')
  203.       IF DATATYPE(testwin,'N') THEN
  204.         DO
  205.           IF savewinnings>0 THEN
  206.             DO
  207.               IF testwin>7200 THEN
  208.                 DO
  209.                   SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR
  210.                   testwin=7200
  211.                 END
  212.               maxtime=TRUNC(testwin+TIME('E'))
  213.               CALL SETCLIP('BBS_maxtime',maxtime)
  214.               winnings=savewinnings
  215.             END
  216.           ELSE
  217.             DO
  218.               winnings=testwin
  219.               CALL SETCLIP('BBS_winnings',winnings)
  220.             END
  221.         END
  222.       CALL SETCLIP('BBS_door')
  223.     END
  224.   ELSE CALL SETCLIP('BBS_localdoor')
  225. END
  226.  
  227.  
  228. sortdoors:
  229. IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
  230. IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  231.   DO
  232.     played=0
  233.     jdoors.=''
  234.     doorlist=SHOWDIR(bbspath'rexxDoors','F')
  235.     doors.=''
  236.     doors.0=WORDS(doorlist)
  237.     DO i=1 TO doors.0
  238.       doors.i=WORD(doorlist,i)
  239.     END
  240.     CALL QSORT(1,doors.0,doors)
  241.     jdoors.0=doors.0%3
  242.     IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
  243.     DO i=1 TO jdoors.0
  244.       DO j=0 TO 2
  245.         k=i+j*jdoors.0
  246.         IF k<=doors.0 THEN
  247.           DO
  248.             jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
  249.             dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
  250.             jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
  251.           END
  252.       END
  253.     END
  254.   END
  255. RETURN 0
  256.  
  257.  
  258. send2log:
  259. PARSE ARG sendline
  260. IF ~frombb THEN RETURN
  261. logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
  262. fl='W'
  263. IF EXISTS(logfile) THEN fl='A'
  264. IF ~OPEN('log',logfile,fl) THEN
  265.   DO
  266.     IF ~OPEN('log',logfile,fl) THEN
  267.       DO
  268.         SAY 'failed to open log file'CR
  269.         RETURN
  270.      END
  271.   END
  272. CALL WRITELN('log','bbsDoors:' sendline)
  273. CALL CLOSE('log')
  274. RETURN
  275.  
  276.  
  277. getinput:
  278. PARSE ARG upflag' 'oneflag' 'pline
  279. CALL checkdcd()
  280. OPTIONS PROMPT pline
  281. PARSE PULL inarg
  282. inarg=STRIP(inarg)
  283. IF upflag THEN inarg=UPPER(inarg)
  284. IF oneflag THEN inarg=LEFT(inarg,1)
  285. inarg=cleanstring(0':'inarg)
  286. CALL checktime()
  287. RETURN inarg
  288.  
  289.  
  290. showtime:
  291. IF ~frombb THEN RETURN
  292. mins=TIME('E')%60
  293. secs=TRUNC(TIME('E')//60)+1
  294. IF secs>59 THEN secs=59
  295. IF secs<10 THEN secs='0'secs
  296. line=' Time:  Used' mins':'secs
  297. mins=(maxtime-TIME('E'))%60
  298. secs=TRUNC((maxtime-TIME('E'))//60)
  299. IF secs<10 THEN secs='0'secs
  300. line=line'   Remaining' mins':'secs
  301. SAY def||line||CR
  302.  
  303. checktime:
  304. IF ~frombb THEN RETURN
  305. IF TIME('E')>maxtime THEN EXIT 0
  306. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  307. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  308. CALL checkdcd()
  309. RETURN
  310.  
  311.  
  312. waiting:
  313. CALL checktime()
  314. IF waitchar='Q' THEN
  315.   DO
  316.     waitchar=''
  317.     RETURN
  318.   END
  319. waitchar=''
  320. IF nonstop=1 THEN RETURN
  321. OPTIONS PROMPT pen3'                          RETURN=Continue 'def
  322. PULL waitchar
  323. CALL checkdcd()
  324. RETURN
  325.  
  326.  
  327. checkdcd:
  328. IF ~frombb THEN RETURN
  329. dcd
  330. IF RC=0 THEN
  331.   DO
  332.     DO dcds=1 TO 3  /* 5 second delay */
  333.       CALL DELAY(50)
  334.       dcd
  335.       IF RC~=0 THEN RETURN
  336.     END
  337.     dcd
  338.     IF RC=0 THEN EXIT
  339.   END
  340. xmsg=GETCLIP('BBS_MESSAGE')
  341. IF xmsg~='' THEN
  342.   DO
  343.     CALL SETCLIP('BBS_MESSAGE')
  344.     SAY CR
  345.     SAY bak2' Message From BBBBS: 'def||CR
  346.     SAY xmsg||CR
  347.     SAY CR
  348.     CALL waiting()
  349.   END
  350. IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT
  351. RETURN
  352.  
  353.  
  354. strip_ansi:
  355. PARSE ARG aline 
  356. n=POS('1B'x,aline)
  357. DO WHILE n>0
  358.   DO k=2
  359.     IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
  360.       leave k
  361.   END
  362.   aline=DELSTR(aline,n,k+1)
  363.   n=POS('1B'x,aline)
  364. END
  365. RETURN aline
  366.  
  367.  
  368. cleanstring:
  369. PARSE ARG nflag':'cstr
  370. IF nflag=1 THEN
  371.   DO
  372.     cstr=COMPRESS(cstr,"'`")
  373.     cstr=TRANSLATE(cstr,,namemask)
  374.     cstr=SPACE(cstr,1,'_')
  375.     RETURN cstr
  376.   END
  377. bot=XRANGE(,'1F'x)
  378. IF nflag=2 THEN bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
  379. ELSE cstr=strip_ansi(cstr)
  380. top=XRANGE('7F'x)
  381. cstr=COMPRESS(cstr,bot||top)
  382. IF nflag=0 THEN cstr=STRIP(cstr)
  383. RETURN cstr
  384.  
  385.  
  386. postuser:
  387. IF ~frombb | ~SHOW('P','BBSPOST') THEN RETURN
  388. ptext=GETCLIP('BBSPOST4')
  389. IF WORDS(ptext)>4 THEN ptext=LEFT(ptext,WORDINDEX(ptext,5)-1)
  390. ptext=STRIP(ptext)
  391. ptext=CENTER(ptext'   Door:' arg,74)
  392. CALL SETCLIP('BBSPOST4',ptext)
  393. ADDRESS BBSPOST 'UPDATE'
  394. RETURN
  395.  
  396.  
  397. bye:
  398. BREAK_C:
  399. IF frombb THEN CALL SETCLIP('BBS_door')
  400. ELSE CALL SETCLIP('BBS_localdoor')
  401. SAY CR
  402. EXIT
  403.  
  404.  
  405. FAILURE:
  406. SYNTAX:
  407. lin.1=''ERRORTEXT(RC)''
  408. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  409. lin.3=SIGL ''SOURCELINE(SIGL)''
  410. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  411. DO er=1 TO 4
  412.   IF level>sysoplevel | ~frombb THEN SAY 'bbsDoors:' lin.er||CR
  413.   IF frombb THEN CALL send2log(lin.er)
  414. END
  415. EXIT
  416.  
  417. /* bbsDoors.rexx */
  418.